home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d2 / setf.arc / SETF.PAS < prev   
Pascal/Delphi Source File  |  1990-03-31  |  13KB  |  411 lines
  1. Program setf;
  2. {
  3.  
  4.     Program       : setf.pas
  5.     Date          : 03/30/90
  6.     Revision      : 2.1
  7.     Description   : Provides a means of setting DOS level function keys.
  8.     Caveats       : F1, 3, 9 and 10 should not be set because of possible
  9.                     interference with DOS and 4DOS.
  10.     Compiler      : Turbo Pascal 5.0 with TP&ASM Inline Assembly Utility
  11.  
  12. }
  13.  
  14. Uses
  15.   Crt, Dos; {Unit found in TURBO.TPL}
  16.  
  17. {$I keydefs.inc}
  18.  
  19.   Const
  20.  
  21.       SCCS_ID         = '@(#)setf.pas, 09-30-90, Revision 2.1\n';
  22.  
  23.   Type
  24.  
  25.       MaxKeys         = 1..40;             { Total number of keys to program }
  26.       StringType      = String[80];        { Some other general types }
  27.       StringLength    = String[79];
  28.       IntType         = Integer;
  29.       ConfigKeys      = ARRAY [MaxKeys] of StringLength;  { Struct for keys }
  30.  
  31.   Var
  32.  
  33.       InFileName      :File of ConfigKeys;  { File for saving keys }
  34.  
  35.       Found,                                { Parameter found indicator }
  36.       Change,                               { Key changed indicator }
  37.       ResultIO        :Boolean;             { Result of file open test }
  38.  
  39.       SCCSID,
  40.       FkeyS,
  41.       Fname           :String[40];
  42.  
  43.       FkeyConfig      :ConfigKeys;
  44.  
  45.       V_Mode,                               { Video Mode result }
  46.       KeyHit,                               { Some other general types }
  47.       Count2,
  48.       Count           :Integer;
  49.  
  50.       Param_Str,
  51.       Response2,
  52.       Response        :StringType;
  53.  
  54.       Resp,
  55.       Fkey            :Char;
  56.  
  57.   {$I getkey.inc}                  { Include to get an input key }
  58.   {$I getstring.inc}               { Include to get a string     }
  59.  
  60. {===========================================================================}
  61.  
  62.  
  63. {   This procedure is used to display a help screen under cetain conditions   }
  64.  
  65.   Procedure PrintHelp;
  66.  
  67.     Begin
  68.       ClrScr;
  69.       Writeln;
  70.       Writeln('This program allows the setting of all 40 DOS function keys.');
  71.       Writeln;
  72.       Writeln;
  73.       Writeln('Usage:  setf [ - or / ] [ hidcl ] [ filename ]');
  74.       Writeln;
  75.       Writeln('Where:    c - configure function keys');
  76.       Writeln('          l - load function keys');
  77.       Writeln('          d - display function key settings');
  78.       Writeln('          h - display this help screen');
  79.       Writeln('          i - program information');
  80.       Writeln('   filename - key configuration file');
  81.       Writeln('               DEFAULT is C:\Fkeys.cfg');
  82.       Writeln;
  83.       Writeln('NOTE: The Extended ANSI driver must be installed');
  84.       Writeln('      for this program to work properly.')
  85.     End;
  86.  
  87.  
  88. {===========================================================================}
  89.  
  90.  
  91. {  Used to get the filename of the configuration file.  Defaults to fkeys.cfg  }
  92.  
  93.   Procedure GetFilename;
  94.  
  95.     Begin
  96.       If ParamCount < 2 Then          { if no filename input }
  97.          Fname := 'c:\Fkeys.cfg'      { assign default filename }
  98.         Else
  99.          Fname := ParamStr(2);     { otherwise get filename from command line }
  100.  
  101.       Assign(InFileName,Fname);       { Assign the file and open file }
  102.       {$I-}
  103.       Reset(InFileName);
  104.       ResultIO := (IOResult = 0);
  105.       {$I+}
  106.       If not ResultIO Then                { if not open now }
  107.          If (Param_Str[2] = 'C') Then     { and configuring keys }
  108.             Rewrite(InFileName)           { create the file }
  109.          Else
  110.           Begin
  111.             Writeln('Unable to open file ',Fname);  { or give error }
  112.             Halt
  113.           End
  114.         Else
  115.           If not EOF(InFileName) Then     { or read in file }
  116.              Read(InFileName, FkeyConfig)
  117.  
  118.     End;
  119.  
  120. {===========================================================================}
  121.  
  122.  
  123. {  This procedure is used to configure the keys in the configuration file.  }
  124.  
  125.   Procedure ConfigureKeys;
  126.  
  127.     Begin
  128.  
  129.       GetFilename;
  130.  
  131.       Response := '';
  132.  
  133.       While not(Response = ESC) Do   { Configure keys until user quits }
  134.         Begin
  135.           ClrScr;
  136.           Write('Enter a Function Key to setup or ESC to quit : ');
  137.           Fkey := Getkey;
  138.           If Fkey = ESC Then
  139.             Exit;
  140.           If (ord(Fkey) IN[187..196,212..241]) Then  { is it a function key }
  141.             Begin
  142.               KeyHit := (ord(Fkey) - 186);    { convert the keycode }
  143.               Fkey := chr(ord(Fkey) - 128);
  144.               str(ord(Fkey):2, FkeyS);
  145.               Resp := 'y';
  146.               If KeyHit IN[1,3,9,10] Then     { test for F1, 3, 9, or 10 }
  147.                 Begin
  148.                   Writeln;
  149.                   Writeln('Changing this key can');
  150.                   Writeln('cause SERIOUS interference with DOS . . .');
  151.                   Writeln;
  152.                   Writeln('Do you wish to continue ? (y/n)');
  153.                   Resp := Getkey;
  154.                   If Resp IN['y','Y'] Then       { Get function key to setup }
  155.                     Begin
  156.                       ClrScr;
  157.                       Write('Enter a Function Key to setup : ')
  158.                     End
  159.                 End;
  160.               If Resp IN['y','Y'] Then
  161.                 Begin
  162.                   If KeyHit > 10 then        { Is key normal function key }
  163.                     KeyHit := KeyHit - 15;   { or is it extended function key }
  164.  
  165.                   Case KeyHit of
  166.                        { DISPLAY THE FUNCTION KEY TO SETUP }
  167.                      1..10     : Writeln('F',KeyHit);
  168.                     11..20     : Writeln('Shift F',KeyHit - 10);
  169.                     21..30     : Writeln('Ctrl F',KeyHit - 20);
  170.                     31..40     : Writeln('Alt F',KeyHit - 30);
  171.  
  172.                   End;  {EndCase}
  173.  
  174.                   Writeln(FkeyConfig[KeyHit]);  { Display old setting }
  175.                   Writeln;
  176.  
  177.                   Writeln('Enter the command you wish to perform ');
  178.                   Writeln('- to Delete    ESC to leave unchanged ');
  179.  
  180.                   Response2 := GetString(Response, 67); { GET SETUP STRING }
  181.  
  182.                    { - deletes else store the new setup }
  183.  
  184.                   If (Response2 <> '-') and (Response2 <> ESC) Then
  185.                    Begin
  186.                     Change := TRUE;     { Set key changed }
  187.                     FkeyConfig[KeyHit] := '[0;'+FkeyS+';"'+Response2+'";13p'
  188.                    End
  189.                   Else
  190.                     If Response = '-' Then
  191.                       Begin
  192.                         Change := TRUE;  { set key changed and delete key }
  193.                         FkeyConfig[KeyHit] := '[0;'+Fkeys+';0;'+Fkeys+';p'
  194.                       End
  195.                      Else
  196.                       Response := ' '   { else do nothing and reset response }
  197.  
  198.                 End;
  199.  
  200.               { Endif KeyHit }
  201.  
  202.             End
  203.         End
  204.  
  205.     End;
  206.  
  207. {===========================================================================}
  208.  
  209.  
  210. {  This procedure reads the configuration file and loads the fkey functions  }
  211.  
  212.   Procedure SetFunctions;
  213.  
  214.     Var
  215.         Key_Code       :String[80];     { String for setting up key }
  216.  
  217.     Begin
  218.  
  219.       GetFilename;
  220.  
  221.       For Count := 1 to 40 Do
  222.         If FkeyConfig[Count] <> NULL Then
  223.            Begin
  224.                                              { generate string to output }
  225.              Key_Code := Concat(ESC, FkeyConfig[Count], '$');
  226.              Assembly
  227.                push ds          ;output the key with assembly
  228.                push ss          ;since Pascal can't do it right
  229.                pop  ds
  230.                lea  dx,Key_Code ;string to setup
  231.                inc  dx
  232.                mov  ah,09h      ;use int 21 to output it
  233.                int  21h
  234.                pop  ds
  235.              End;
  236.  
  237.         End;
  238.  
  239.         Writeln;
  240.         Writeln('Function keys set via ',Fname)  { tell user we're done }
  241.  
  242.     End;
  243.  
  244. {===========================================================================}
  245.  
  246. {  This procedure displays the function key settings.  }
  247.  
  248.   Procedure DispFunctions;
  249.  
  250.     Var   Count2        :Integer;
  251.  
  252.     Begin
  253.  
  254.       GetFileName;
  255.  
  256.                            { Search and display Funtion Keys }
  257.  
  258.       For Count := 1 to 40 Do
  259.           If (FkeyConfig[Count][1] <> NULL) and (FkeyConfig[Count][8] <> ';')
  260.              and (FkeyConfig[Count][9] <> ';')  Then Begin
  261.             Count2 := 1;
  262.             While FkeyConfig[Count][Count2] <> '"' Do
  263.               Count2 := Count2 + 1;
  264.             Count2 := Count2 + 1;
  265.             If FkeyConfig[Count][Count2] <> '"' Then
  266.               Begin
  267.                 Writeln;
  268.                 Case Count of
  269.  
  270.                     1..10     : Write(' F',Count:2,' = ');
  271.                    11..20     : Write('SF',(Count - 10):2,' = ');
  272.                    21..30     : Write('CF',(Count - 20):2,' = ');
  273.                    31..40     : Write('AF',(Count - 30):2,' = ');
  274.  
  275.                 End;
  276.                           { Display Function Key Found }
  277.               End;
  278.             While Count2 < 79 Do
  279.               If FkeyConfig[Count][Count2] <> '"' Then
  280.                  Begin
  281.                    Write(FkeyConfig[Count][Count2]);
  282.                    Count2 := Count2 + 1
  283.                  End
  284.                 Else
  285.                  Count2 := 79
  286.           End;
  287.  
  288.       Writeln;
  289.  
  290.     End;
  291.  
  292. {===========================================================================}
  293.  
  294.  
  295. {  This procedure tests the paramaters and processes command accordingly  }
  296.  
  297.   Procedure ProcessParams;
  298.  
  299.   Begin
  300.  
  301.     If (Param_Str[2] = 'H') Then
  302.        PrintHelp;
  303.  
  304.     If (Param_Str[2] = 'I') or (Param_Str[2] = 'H') Then Begin
  305.        Found := TRUE;
  306.        Writeln;
  307.        Writeln('  Version  -  2.1');
  308.        Writeln('  Compiler -  Turbo Pascal Ver. 5.0');
  309.        Writeln('           -  TP&Asm InLine Assembly Utility');
  310.        Writeln('  Purpose  -  Provides means for setting DOS function keys');
  311.        Writeln;
  312.     End;
  313.  
  314.  
  315.     For Count := 1 to 40 Do               { Clear out the buffer area }
  316.       For Count2 := 0 to 79 Do
  317.          FkeyConfig[Count][Count2] := NULL;
  318.  
  319.     Change := FALSE;
  320.  
  321.  
  322.     If (Param_Str[2] = 'L') Then Begin    { -l loads the keys }
  323.        Found := TRUE;
  324.        SetFunctions
  325.     End;
  326.  
  327.     If (Param_Str[2] = 'D') Then Begin    { -d displays the setup file }
  328.        Found := TRUE;
  329.        DispFunctions
  330.     End;
  331.  
  332.     If (Param_Str[2] = 'C') Then Begin    { -c configures the keys }
  333.        Found := TRUE;
  334.        ConfigureKeys;
  335.  
  336.        If Change = TRUE Then Begin        { save only if change made }
  337.           Resp := NULL;
  338.           Writeln;
  339.           Write('Save Changes ? ');           { Save config to disk }
  340.           Resp := Getkey;
  341.           If Resp IN['Y','y'] Then Begin
  342.              Rewrite(InFileName);
  343.              Write(InFileName, FkeyConfig);
  344.              Close(InFileName);
  345.              Writeln;
  346.              Writeln('Keys saved to ',Fname)
  347.           End;
  348.           Writeln;                            { Setfunctions before exit }
  349.           Write('Set function keys now ? ');
  350.           Resp := Getkey;
  351.           Writeln;
  352.           Writeln;
  353.           If Resp IN['Y','y'] Then
  354.              SetFunctions
  355.           End;
  356.  
  357.        End;
  358.  
  359.     End;
  360.  
  361.  
  362. {===========================================================================}
  363.  
  364.  
  365.   Begin           {   Main Program Module   }
  366.  
  367.     SCCSID    := SCCS_ID;
  368.  
  369.     Found     := FALSE;
  370.  
  371.     Assembly                          { Check Video Mode }
  372.       mov  ax,0f00h
  373.       int  10h
  374.       xor  ah,ah
  375.       mov  V_Mode,ax
  376.     End;
  377.  
  378.     If V_Mode IN[0..3] Then           { Check for snow if CGA }
  379.        CheckSnow := TRUE;
  380.  
  381.     CheckBreak:= TRUE;        { Turn break check on }
  382.  
  383.     Param_Str := ParamStr(1);               { Get function parameter }
  384.     Param_Str[2] := UpCase(Param_Str[2]);
  385.  
  386.     If ParamCount = 0 Then
  387.       Begin
  388.         Writeln;
  389.         Writeln('This program allows setting of all 40 of the function');
  390.         Writeln('keys available to DOS. ');
  391.       End;
  392.     { Endif }
  393.  
  394.     If ParamCount > 0 Then Begin
  395.        ProcessParams;
  396.        If (not Found) Then Begin
  397.           Writeln('setf:  error:  Unknown option: ',Param_Str[2]);
  398.           Writeln('setf:  usage:  setf [/ or -] [ hidcl ] [ filename ]');
  399.           Writeln('               setf -h or HELP');
  400.        End;
  401.       End Else Begin
  402.          Writeln;
  403.          Writeln('usage:  setf [ / or - ] [ hidcl ] [ filename ]');
  404.          Writeln('        setf -h for HELP');
  405.          Writeln;
  406.          Writeln('NOTE:   The Extended ANSI driver must be installed.')
  407.        End;
  408.  
  409.  
  410.   End.
  411.